00100	;Floppy disk file system.
00200	.INSERT ASMBL.FAI[CMS,LCS]
00300	   RETRY ← =10	;Number of retrys until error.
00400	   DMARK ← 74	;Directory mark
00500	   FMARK ← 72	;File mark
00600	   HMARK ← 67	;Hole mark?
00700	   LASTRK ← =34	;Last track
00800	   ZERO ← 274 ↔ LOC ZERO ;Fail offset
00900	CBLK:	0	;Ram command block.
01000	CCNT:	0	;C parameter count.
01100	CLEN:	0	;C # of sectors.
01200	CSEC:	0	;C sector
01300	CTRK:	0	;C track
01400		0
01500	FOTRK:	0	;Format track number.
01600		0
01700	FCMD:	0	;Disk command pointer.
01800	FCMDH:	0
01900	CMDJMP:	0	;Indirect command jump.
02000	CJMPH:	0	;Msbyte.
02100	ERFLG:	0	;Error flag/code.
02200	SVERR:	0	;Saved error.
02300	CEFLG:	0	;Communication error flag.
02400	RFOPEN:	0	;Read file open flag.
02500	WFOPEN:	0	;Write file open flag
02600	DIRC:	0	;Data direction
02700	FLEN:	0	;File length. In sectors.
02800	SREM:	0	;Sectors remaining.
02900	NTRYS:	0	;Number of retrys before error.
03000	BUSY:	0	;Busy flag
03100	MO:	0	;Motor on flag. MFLG = TL or TH?
03200	TL:	0	;Motor time out low.
03300	TH:	0	;Time out high.
03400	DIRCNT:	0	;Directory sector count
03500	HTRK:	0	;Hole track number
03600	HSEC:	0	;Hole sector number
03700	SVHY:	0	;Hole directory index.
03800	SVHSEC:	0	;Hole directory sector.
03900	FBLK:	0	;File block
04000	FNAME:	BLOCK 11	;9 Chr file name.
04100	NSEC:	0	;Number of sectors in file.
04200	FTRK:	0	;Disk track number
04300	FSEC:	0	;Disk sector number
04400		BLOCK 3
04500	DBLK:	0	;Directory block
04600	DSEC:	0	;Number of sectors in directory.
04700	FFDIR:	0	;First free directory block
04800	FFTRK:	0	;First free data track
04900	FFSEC:	0	;First free data sector
05000	FBLKS:	0	;Number of free sectors. In sectors.
05100	FBH:	0	;Msbyte
05200		0
05300	CKSUM:	0	;Check sum.
05400	SPOINT:	0	;SI/O pointer.
05500	SPOH:	0	;Msbyte
05600	DPOINT:	0	;Disk buffer bointer.
05700	DPOH:	0	;Msbyte
05800	   LOC ZERO+1000
05900	FBUF:	0	;Disk buffer
06000	   LOC FBUF + 400
06100	FBUF1:	0	;Other disk buffer.
     

00100	FCTBL:	LOC ZERO+174000	;PROM Start address.
00200	   DINIT ← 0
00300		65	;Specify
00400		4	;Parameter count.
00500		252	;H unload I cnt./ H load time.
00600		=25	;Head settling time in ms*2.
00700		=20	;Step rate in ms*2.
00800		15	;Init
00900	   SBT ← 6
01000		65	;Specify
01100		4
01200		0	;Current track.
01300		377
01400		377	;No bad tracks.
01500		20	;Surface zero bad tracks command.
01600	   DMA ← 14
01700		172	;Write special register.
01800		2
01900		0	;DMA and double actuator.
02000		27	;Mode register.
02100	   RESTOR ← 20
02200		151	;Seek track zero command.
02300		1	;With head load.
02400		0	;Track zero
02500	   MON ← 23
02600		172	;Write special register.
02700		2	;Clear out pins.
02800		40	;Optional output / motor on bit.
02900		43	;Drive control output register.
03000	   MOFF ← 27
03100		172	;Write special register.
03200		2	;Clear out pins.
03300		0	;Optional output / motor off.
03400		43	;Drive control output register.
03500	   RHDR0 ← 33
03600	RH0:	123	;Read two sectors command.
03700		3
03800		2	;# of sectors.
03900		1	;Header sector number
04000		0	;Header track number
04100	   WHDR0 ← 40
04200	WH0:	113	;Write two sectors command.
04300		3
04400		2	;# of sectors.
04500		1	;Header sector number.
04600		0	;Header track number.
04700	    RDSTAT ← 45
04800		154	;Read drive status command.
04900		0
05000	ID0:	113	;Write two sectors.
05100		3
05200		=16	;# of sectors.
05300		1	;First sector.
05400		0	;Track zero.
05500	FORMT:	143	;Format track command.
05600		5
05700		=16	;Gap 1 -6.
05800		0	;Gap 5. No index mark.
05900		=16	;Sectors per track.
06000		=27	;Gap 3 -6.
06100		0	;Format track number.
     

00100	;Restore bug in 8271?
00200	;Put GEOT in DECODE.
00300	;Add restore to retry?
00400	;COMERRs ?  In ACK?
00500	;Add write protect and not ready error codes.
00600	;Flush other dir. = LASTRK?
00700	
00800	;Power on reset.
00900	RST:	LDXI	377	;Setup stack.
01000		TXS
01100		CLD	;Clear decimal mode.
01200	
01300	;Reset I/O
01400	   SIOC  ← 20000	;SI/O command register.
01500	   SIOD  ← 20001	;SI/O data register.
01600	   FDSKC ← 10000	;Disk command/status register
01700	   FDSKP ← 10001	;Disk parameter/result register
01800	   FDSKR ← 10002	;Disk reset register.
01900	   FDRQ  ← 14000	;Disk DMA data request
02000	
02100	;Init floppy disk controller.
02200		LDAI	1	;Reset disk again.
02300		STA	FDSKR
02400		NOP
02500		NOP
02600		NOP
02700		LSRA	;Clear A
02800		STA	FDSKR
02900	
03000		LDAI	DINIT	;Disk initialization command.
03100		JSR	PCMD	;Prom command.
03200		LDAI	DMA	;Setup DMA mode.
03300		JSR	PCMD
03400		LDXI	377
03500		STXZ	TL
03600		LDAI	10
03700		STAZ	TH
03800	RLOOP:	DEX
03900		BNE	RLOOP
04000		DECZ	TL
04100		BNE	RLOOP
04200		DECZ	TH
04300		BNE	RLOOP
04400	
04500		LDAI	RESTOR	;Restore track zero.
04600		JSR	PCMD	;Add delay? Read sp. reg?
04700	
04800		LDAI	SBT	;Setup bad tracks
04900		JSR	PCMD
05000		LDA	FDSKP	;Read result reg. to clr int.?
05100	;Reset SI/O
05200		LDAI	3	;Reset bits
05300		STA	SIOC
05400		LDAI	25	;ACIA control word.
05500		STA	SIOC
05600	
05700	;Init RAM
05800		LDAZ	DSEC
05900		STAZ	DIRCNT	;Point to end of directory.
06000		LDAI	0
06100		STAZ	MO	;Init motor flag.
     

00100	IDLSET:	LDAI	0
00200		STAZ	RFOPEN	;Reset read file open flag.
00300		STAZ	WFOPEN	;Clear write file open flag.
00400	
00500		STAZ	CEFLG	;Clear comm. error flag.
00600		STAZ	ERFLG	;Clear error flag.
00700		STAZ	SVERR	;Clear other error flag.
00800	
00900		STAZ	DIRC	;Set disk to read.
01000		STAZ	BUSY	;Set to not busy.
01100		TAX	;Start lsbyte of motor time out.
01200		CLI	;Enable interrupts?
01300	
01400	   TWOS ← 3	;3 = 1.77s, 4 = 2.3s.
01500	;	JSR	IDLEW	?
01600	IDLE:	BITZ	MO	;Check if motor on.
01700		BPL	GSOH
01800		LDA	SIOC	;Read SI/O status.
01900		LSRA	;Get rcvr. full bit.
02000		BCS	GSOH
02100	
02200		DEX	;Time out countdown.
02300		BNE	IDLE
02400		DECZ	TL
02500		BNE	IDLE
02600		DECZ	TH
02700		BNE	IDLE
02800		JSR	MOTOFF	;Turn off motor.
02900	   ;Check for file open??
03000	;	JMP	IDLSET	?
03100	
03200	GSOH:	JSR	GCHR	;Wait for SOH.
03300		CMPI	1	;<SOH>.
03400		BNE	ILLCMD	;Error.
03500		JSR	GCHR	;Wait for command.
     

00100	DCODE:	LDXI	NCMDS	;# of commands.
00200	DL:	CMPX	CMDTBL	;Check if valid command.
00300		BEQ	JCMD
00400		DEX
00500		BPL	DL
00600	;Illegal command.
00700	ILLCMD:	LDXI	4	;Command error code.
00800	OCLR:	JSR	OCHR	;Output status.
00900		JMP	IDLSET	;Reset flags.
01000	
01100	JCMD:	LDAX	JLTBL	;Get lsbyte of jump address.
01200		STAZ	CMDJMP
01300		LDAX	JHTBL	;Get msbyte.
01400		STAZ	CJMPH
01500	
01600		JMPIN	CMDJMP	;Excute command.
01700	   ;Fix JMPIN in ASMBL.FAI.
01800	
01900	   NCMDS ← =9	;# of commands -1.
02000	;Swap order for faster DECODE?
02100	CMDTBL:	"W"	;Write data
02200		"R"	;Read data
02300		"E"	;Enter write file.
02400		"C"	;Close write file.
02500		"O"	;Open read file.
02600		"K"	;Delete file.
02700		"D"	;Open directory.
02800		"N"	;Next directory block.
02900		"B"	;Free blocks
03000		"P"	;Perform special function.
03100	
03200	;Check all funny addresses.
03300	JLTBL:	WRITE∧377	;Lsbyte of command address.
03400		READ∧377
03500		ENTR∧377
03600		CLOZE∧377
03700		OPIN∧377
03800		KIL∧377
03900		DIR∧377
04000		NXTDIR∧377
04100		BLKS∧377
04200		PSF∧377
04300	
04400	JHTBL:	WRITE⊗-10	;Msbyte of command address.
04500		READ⊗-10
04600		ENTR⊗-10
04700		CLOZE⊗-10
04800		OPIN⊗-10
04900		KIL⊗-10
05000		DIR⊗-10
05100		NXTDIR⊗-10
05200		BLKS⊗-10
05300		PSF⊗-10
     

00100	;Write command to FDSKC. No wait or * NTRYS.
00200	PCMD:	STAZ	FCMD	;Prom command with no retrys.
00300		LDAI	370	;Msbyte of command table addr.
00400		STAZ	FCMDH
00500		LDAI	0
00600		STAZ	NTRYS
00700		BEQ	WCMD	;Jump.
00800	
00900	RCMD:	LDAI	0	;Ram command with no retrys.
01000		STAZ	NTRYS
01100	TRY:	LDAI	0
01200		STAZ	FCMD
01300		STAZ	FCMDH
01400	
01500	WCMD:	LDAI	377	;Set busy.
01600		STAZ	BUSY	;?
01700		LDAI	0
01800		STAZ	DPOINT	;Reset disk DMA pointer.
01900	
02000	BSYW:	LDA	FDSKC	;Wait until not busy.
02100		BMI	BSYW
02200	;	ANDI	100	Command full bit.
02300	;	BNE	BSYW	Wait until cmd. reg. empty.
02400	
02500		LDYI	0
02600		LDAIY	FCMD	;Get command code.
02700		STA	FDSKC	;Write in disk control reg.
02800	
02900		INCZ	FCMD	;Point to parameter count.
03000		LDAIY	FCMD	;Get count.
03100		BEQ	NOPAR	;If no parameters
03200		TAY
03300	
03400	;FULLW:	LDA	FDSKC	Read disk status.
03500	;	ANDI	100	Command full bit.
03600	;	BNE	FULLW	Wait until empty?
03700	
03800	PARW:	LDA	FDSKC	;Read status
03900		ANDI	40	;P reg full bit.
04000		BNE	PARW	;Wait if still full.
04100	
04200		LDAIY	FCMD	;Parameter
04300		STA	FDSKP
04400		DEY
04500		BNE	PARW	;More left?
04600	
04700	NOPAR:	RTS
04800	
04900	;Disk command with retrys on read error.
05000	RCMDR:	LDAI	RETRY
05100		STAZ	NTRYS
05200		JSR	TRY	;RAM disk command.
05300		RTS
05400	
05500	RCMDW:	JSR	RCMDR	;Read command wait.
05600	BW:	BITZ	BUSY
05700		BMI	BW	;Wait until done
05800		LDAZ	ERFLG	;Get error bits.
05900		RTS	;Return with error bits.
     

00100	;IRQ maskable interrupt routines.
00200	IRQV:	PHA	;Save Registers.
00300		TYA
00400		PHA
00500	
00600	   ;Wait for result bit?
00700		LDA	FDSKP	;Read disk result register.
00800		ANDI	36	;Flush ddbit
00900		STAZ	ERFLG
01000		BNE	DSKERR	;Disk error.
01100		BITZ	DIRC	;Check if write.
01200		BPL	NOTBSY	;No errors.
01300		LDAI	0
01400		STAZ	DIRC	;Not write.
01500		LDAZ	CBLK
01600		CMPI	143	;Check if format command.
01700		BEQ	NOTBSY
01800	
01900		LDAI	137	;Disk verify command.
02000		STAZ	CBLK
02100		JSR	WCMD	;Verify write.
02200	
02300		JMP	RTRN	;Wait until done.
02400	
02500	DSKERR:	ANDI	20	;Bad bit
02600		BEQ	CKTRY
02700	;Dsk error: RDY,WRT fault, etc.
02800		STAZ	SVERR	;Save bad error.
02900		LDAI	RDSTAT	;Read dirve status.
03000		JSR	PCMD	;No interrupt.
03100		LDA	FDSKP	;Read result register.
03200	;Put error routine someplace else?
03300	;20 Not ready.
03400	;21 Write protect.
03500	;22 Restore error.
03600	;23 File not found.
03700	;30 Sector not found.
03800	;Read drive status if not ready for clear.
03900		JMP	NOTBSY
04000	
04100	CKTRY:	LDAZ	NTRYS
04200		BEQ	SETERR
04300		
04400		DECZ	NTRYS
04500		JSR	WCMD	;Retry command.
04600		JMP	RTRN	;Wait until done.
04700	
04800	SETERR:	LDAI	377	;Retry error.
04900		STAZ	SVERR
05000	
05100	NOTBSY:	LDAI	0
05200		STAZ	BUSY	;Set done
05300		STAZ	DIRC	;Reset to read.
05400	
05500	RTRN:	PLA	;Restore Registers.
05600		TAY
05700		PLA
05800		RTI	;Return
     

00100	;Non-maskable DRQ interrupt.
00200	NMIV:	PHA	;Save registers
00300		TYA
00400		PHA
00500		LDYI	0	;No index.
00600	
00700		BITZ	DIRC	;Get direction.
00800		BMI	WDRQ	;Disk write.
00900	
01000		LDA	FDRQ	;Read byte from disk.
01100	
01200		STAIY	DPOINT	;Save it in FBUF
01300		JMP	INCPO	;Increment disk buffer pointer.
01400	
01500	WDRQ:	LDAIY	DPOINT	;Get byte from FBUF.
01600		STA	FDRQ	;Write in disk data register.
01700	
01800	INCPO:	INCZ	DPOINT
01900	
02000		PLA	;Restore registers.
02100		TAY
02200		PLA
02300		RTI	;Return
     

00100	;Directory look up.
00200	;Returns with file found, fnf, or read error.(0,200,XX)
00300	LOKUP:	LDXI	0
00400	GNAME:	JSR	GCHR	;Get name.
00500		STAZX	FNAME
00600		INX
00700		CPXI	=10	;9 Chr file name + EOT.
00800		BCC	GNAME
00900	
01000		CMPI	4	;EOT
01100		BEQ	GHD
01200		PLA	;One level pop to ILLCMD.
01300		PLA
01400		JMP	ILLCMD
01500	
01600	GHD:	JSR	RHDR	;Read directory header sector.
01700		BNE	LUERR
01800		LDAI	FMARK
01900		STAZ	FBLK
02000	
02100	GETS:	JSR	RNDS	;Read next 2 directory sectors.
02200		BNE	LUERR
02300		LDYI	0
02400	CKDIR:	LDXI	0
02500	CKNAM:	LDAY	FBUF
02600		CMPZX	FBLK	;Look for file name.
02700		BNE	NXTF	;No match
02800		INY
02900		INX
03000		CPXI	=11	;9 chrs. + fmark + 1.
03100		BCC	CKNAM
03200	;Names match
03300	FMOV:	LDAY	FBUF	;Save file record.
03400		STAZX	FBLK
03500		INY
03600		INX
03700		CPXI	20
03800		BCC	FMOV
03900	
04000		LDAI	0	;Return with file found.
04100	LUERR:	RTS	;Return with error bits.
04200	
04300	NXTF:	TYA	;Point to next file record.
04400		ORAI	17
04500		TAY
04600		INY
04700		BNE	CKDIR
04800	
04900		DECZ	SREM	;Check if more sectors.
05000		DECZ	SREM
05100		BNE	GETS
05200		LDAI	200	;Return file not found code.
05300		RTS
     

00100	;Read 1st sec of a directory. Returns with 0 or Ebits.
00200	RHDR:	JSR	MOTON	;Turn on motor and delay.
00300		LDXI	4
00400	CSET:	LDAX	RH0	;Setup command list.
00500		STAZX	CBLK
00600		DEX
00700		BPL	CSET
00800	
00900		JSR	SETDPO	;Point disk to FBUF.
01000		JSR	RSEC	;Read it * 16.
01100		BNE	HERR
01200		LDA	FBUF
01300		CMPI	DMARK	;Check for directory.
01400		BNE	HERR
01500	
01600	GHDR:	LDXI	7
01700	GHL:	LDAX	FBUF
01800		STAZX	DBLK
01900		DEX
02000		BPL	GHL
02100		LDAZ	DSEC
02200		STAZ	SREM	;Number of sectors in dir.
02300		STAZ	DIRCNT	;Reset directory count.
02400		LDAI	0	;No error return
02500	HERR:	RTS	;Return with error bits.
02600	
02700	;Read next dir. sector. Returns with error bits.
02800	RNDS:	INCZ	CSEC	;Read next dir sec.
02900		INCZ	CSEC
03000	RSEC:	JSR	RCMDW	;Disk command wait * RETRYS
03100		BEQ	GOTIT	;Good read
03200		LDAI	LASTRK	;Last track
03300		STAZ	CTRK
03400		JSR	RCMDW
03500		LDAI	0	;Fix CTRK for next read.
03600		STAZ	CTRK
03700		LDAZ	ERFLG	;Get error bits.
03800	GOTIT:	RTS	;Return with error bits.
03900	
04000	SETDPO:	LDAI	0	;Point disk to FBUF
04100		STAZ	DPOINT
04200		LDAI	FBUF⊗-10
04300		STAZ	DPOH
04400		RTS
     

00100	;Open read file.
00200	OPIN:	BITZ	WFOPEN	;Check if write file open.
00300		BPL	LOOK
00400		JMP	FAO	;File already open error.
00500	
00600	LOOK:	JSR	LOKUP	;Lookup file FNAM
00700		BEQ	SETOPN
00800		CMPI	200	;File not found code.
00900		BEQ	NACKIT
01000		JMP	DIRERR	;Directory read error
01100	NACKIT:	JMP	FNF	;File not found.
01200	
01300	SETOPN:	LDAZ	FTRK	;Get track and sector
01400		STAZ	CTRK
01500		LDAZ	FSEC
01600		STAZ	CSEC
01700		LDAZ	NSEC	;Get file length.
01800		STAZ	SREM
01900	;Fill FBUF
02000		JSR	RCMDR	;* NTRYS and no wait.
02100	
02200		JSR	SETSPO	;Point SPOINT to FBUF.
02300		LDAI	377
02400		STAZ	RFOPEN
02500	
02600	ACK:	LDXI	6	;<ack>
02700	OACK:	JSR	OCHR	;Output byte.
02800		JSR	SPIN
02900		JMP	IDLE	;No flag clear.
03000	
03100	SETSPO:	LDAI	0	;Reset SI/O pointer.
03200		STAZ	SPOINT
03300		LDAI	FBUF⊗-10
03400		STAZ	SPOH
03500		RTS
     

00100	;Read a block of the file.
00200	READ:	JSR	GEOT	;Wait for EOT.
00300		BITZ	RFOPEN	;Check if file open.
00400		BMI	CKS
00500		JMP	FNF	;File not found
00600	CKS:	LDAZ	SREM	;Check for end of file.
00700		BNE	READO	;For FLEN = 0.
00800	EOF:	LDXI	6	;End of file error code.
00900		JMP	OCLR	;Output X and clear flags.
01000	
01100	READO:	LDAI	0	;Init check sum.
01200		STAZ	CKSUM
01300	RW:	BITZ	BUSY	;Wait until not busy.
01400		BMI	RW
01500		LDAZ	ERFLG	;Check for *16 read error.
01600		BEQ	NXTBUF
01700	   ;Output 256 zeros?
01800	DRERR:	LDXI	14	;Disk read error.
01900		JMP	OCLR
02000	
02100	NXTBUF:	DECZ	SREM	;Check if end of file.
02200		DECZ	SREM
02300		BEQ	ACKIT
02400	   ;Start read of next buffer.
02500		INCZ	CSEC	;Next sector.
02600		INCZ	CSEC
02700		LDAZ	CSEC	;Check if next track.
02800		CMPI	=16
02900		BCC	RNS
03000		LDAI	1	;First sector.
03100		STAZ	CSEC
03200		INCZ	CTRK	;Next track.
03300	
03400	RNS:	JSR	SWDBUF	;Swap disk buffers.
03500		JSR	MOTON	;Turn on motor.
03600		JSR	RCMDR	;No wait.
03700	ACKIT:	JSR	PACK	;Output <ack>.
03800		JSR	PSTX	;Output <stx>.
03900	
04000		LDYI	0
04100	RDIT:	LDAIY	SPOINT	;Output a buffer full.
04200		TAX
04300		JSR	OCHR
04400		TXA
04500		CLC
04600		ADCZ	CKSUM
04700		STAZ	CKSUM
04800		INY
04900		BNE	RDIT
05000	
05100		JSR	SWSBUF	;Swap SI/O buffers.
05200		LDAZ	CKSUM	;Output check sum.
05300		EORI	377
05400		TAX
05500		INX
05600		JMP	OACK	;Output it and no flag clear.
05700	
05800	SWSBUF:	LDAZ	SPOH
05900		EORI	1	;Swap SI/O buffers.
06000		STAZ	SPOH
06100		RTS
     

00100	;Create file routine
00200	ENTR:	BITZ	WFOPEN	;Check if file already open
00300		BPL	CLRFO
00400	FAO:	LDXI	10	;File already open error.
00500		JMP	OACK	;Output it.
00600	CLRFO:	LDAI	0	;Put clear read file in RHDR?
00700		STAZ	RFOPEN	;Close read file.
00800	LOKIT:	JSR	LOKUP	;Check if file already exists.
00900		BEQ	FEXIST	;Check if file exists
01000		CMPI	200	;Not in dir. code
01100		BEQ	FULCK
01200	DIRERR:	LDXI	13	;Directory read error code.
01300		JMP	OCLR	;Clear flags.
01400	
01500	FEXIST:	LDXI	2	;File exists error code.
01600		JMP	OCLR	;Clear flags.
01700	
01800	DSKFUL:	LDAI	LASTRK	;Disk full. Check close?
01900		STAZ	FFTRK	;Set full flag.
02000		LDXI	5	;Disk full code.
02100		JMP	OCLR	;Output and clear flags?
02200	
02300	FULCK:	LDAZ	FFTRK	;Get first free track.
02400		CMPI	LASTRK	;Check if disk full.
02500		BCS	DSKFUL
02600	
02700		STAZ	CTRK	;Point to new file.
02800		STAZ	FTRK	;Setup file block.
02900		STAZ	CLEN	;Track number for seek.
03000		LDAI	151	;Seek track command.
03100		STAZ	CBLK
03200		LDAI	1
03300		STAZ	CCNT
03400	
03500		JSR	RCMD	;Seek track.
03600	
03700		LDAI	3	;Setup command parameter count.
03800		STAZ	CCNT
03900		STAZ	DPOH	;Point disk to other buffer.
04000		LDAI	2	;Setup number of sectors.
04100		STAZ	CLEN
04200		LDXZ	FFSEC
04300		STXZ	FSEC	;Setup file block.
04400		DEX	;-1 For inc. before write.
04500		DEX
04600		STXZ	CSEC
04700	
04800		JSR	SETSPO	;Point SI/O to FBUF.
04900		LDAI	0
05000		STAZ	FLEN	;Reset file length.
05100	
05200		LDAI	377	;Set write file open flag.
05300		STAZ	WFOPEN
05400		JMP	ACK	;Return with no errors
     

00100	;Write file.
00200	;Fix full check for write last sector?
00300	WRITE:	JSR	GEOT	;Wait for EOT.
00400		BITZ	WFOPEN	;Check if file open.
00500		BMI	WIT
00600		JMP	FNF	;File not found
00700	WIT:	LDAZ	FFTRK
00800		CMPI	LASTRK	;Check if disk is full.
00900		BCS	DSKFUL
01000	
01100		LDAI	0
01200		STAZ	CKSUM	;Init check sum.
01300	
01400		JSR	PACK	;Output <ACK>.
01500		JSR	GCHR	;Wait for STX.
01600		CMPI	2	;<STX>.
01700		BNE	COMERR	;No STX.
01800	   ;Check for COMERR?
01900	
02000		LDYI	0
02100	WLOOP:	JSR	GCHR	;Fill FBUF.
02200		STAIY	SPOINT
02300		CLC
02400		ADCZ	CKSUM	;Update check sum.
02500		STAZ	CKSUM
02600		INY
02700		BNE	WLOOP
02800	
02900		JSR	GCHR	;Get check sum.
03000		CLC
03100		ADCZ	CKSUM	;Check for check sum error.
03200		BNE	COMERR
03300		LDAZ	CEFLG	;Check for communication error.
03400		BEQ	WBUF
03500	COMERR:	LDXI	11	;Communication error.
03600		JMP	OCLR	;Reset flags.
03700	
03800	WBUF:	BITZ	BUSY	;Wait until last buffer done.
03900		BMI	WBUF
04000		LDAZ	ERFLG	;Check for errors.
04100		BEQ	NFBLK
04200		JMP	DRERR	;Write error. Verify error?
04300	NFBLK:	LDXZ	CSEC	;Fix sector number.
04400		INX
04500		INX
04600		CPXI	=16	;Check if end of track.
04700		BCC	SWBUF
04800		LDXI	1	;First sector.
04900		INCZ	CTRK	;Next track.
05000		LDAZ	CTRK
05100		CMPI	LASTRK	;Check if disk full?
05200		BCC	SWBUF
05300		JMP	DSKFUL
     

00100	SWBUF:	STXZ	CSEC	;Next sector.
00200		JSR	SWDBUF	;Swap disk buffers.
00300		JSR	MOTON	;Turn on motor.
00400		JSR	WBUFR	;Write buffer.
00500		
00600		JSR	SWSBUF	;Swap SI/O buffers.
00700		INCZ	FLEN	;Update file length.
00800		INCZ	FLEN
00900		JMP	ACK	;No error return.
01000	
01100	WBUFR:	LDAI	113	;Write two sectors command.
01200		STAZ	CBLK
01300	WUF:	LDAI	377
01400		STAZ	DIRC	;Set to write.
01500		JSR	RCMDR	;* NTRYS.
01600		RTS
01700	
01800	WBUFW:	JSR	WBUFR	;Write it.
01900	WW:	BITZ	BUSY
02000		BMI	WW	;Wait until not busy.
02100		LDAZ	ERFLG
02200		RTS
02300	
02400	SWDBUF:	LDAZ	DPOH
02500		EORI	1	;Swap disk buffers.
02600		STAZ	DPOH
02700		RTS
     

00100	CLOZE:	JSR	GEOT	;Wait for EOT.
00200		BITZ	WFOPEN	;Check if file open
00300		BMI	UPDIR
00400		JMP	FNF	;File not found.
00500	
00600	;Update directory
00700	UPDIR:	BITZ	BUSY	;Wait until not busy.
00800		BMI	UPDIR
00900		LDAZ	ERFLG	;Check for error.
01000		BEQ	BUMP
01100		JMP	DRERR	;Last buffer write error?
01200	
01300	BUMP:	LDAZ	FLEN	;Save file length.
01400		STAZ	NSEC
01500		LDAZ	CTRK	;Save new FFTRK.
01600		STAZ	HTRK
01700		LDXZ	CSEC	;Point to next free data block.
01800		INX
01900		INX
02000		CPXI	=16	;Number of secs. per track +1.
02100		BCC	FIXFF
02200		INCZ	HTRK	;Next track.
02300		LDXI	1	;First sector.
02400	FIXFF:	STXZ	HSEC	;Save new FFSEC.
02500	
02600	;Read directory header and last directory sector.
02700		JSR	RHDR	;Read dir. header
02800		BNE	RDE	;Dir. read error.
02900		LDXZ	DSEC	;Last directory sector -1.
03000		INX	;Bump.
03100		STXZ	CSEC
03200		STXZ	SREM	;Save last dir. sec. number.
03300		JSR	SWDBUF	;Swap bufs.for last dir. save.
03400		JSR	RSEC	;Read next dir. sec.
03500		BEQ	CLOZIT
03600	RDE:	JMP	DIRERR	;Directory read error.
03700	
03800	CLOZIT:	LDYZ	FFDIR
03900	
04000		LDXI	0	;BLT FBLK into directory
04100	NAMEIT:	LDAZX	FBLK
04200		STAY	FBUF1	;Other buffer.
04300		INY
04400		INX
04500		CPXI	20	;FBLK Length
04600		BCC	NAMEIT
04700	
04800		JSR	WBUFW	;Write directory 0.
     

00100	;Update directory header.
00200	WRTH0:	CLC
00300		LDAZ	FFDIR
00400		ADCI	20	;Update end of dir.
00500		STAZ	FFDIR
00600		BNE	UPFF
00700		INCZ	DSEC	;Next sector
00800		INCZ	DSEC
00900		LDAZ	DSEC	;Check if directory full.
01000		CMPI	=15
01100		BCC	UPFF
01200		LDAI	=14	;Last directory sector.
01300		STAZ	DSEC
01400		LDAI	LASTRK	;Set disk full.
01500		STAZ	HTRK
01600	UPFF:	LDAZ	HSEC	;Point to next free block.
01700		STAZ	FFSEC
01800		LDAZ	HTRK
01900		STAZ	FFTRK
02000		SEC
02100		LDAZ	FBLKS
02200		SBCZ	FLEN	;Update free blocks.
02300		STAZ	FBLKS
02400		BCS	SVSEC
02500		DECZ	FBH
02600	
02700	SVSEC:	LDXI	7	;Header length
02800	HLOOP:	LDAZX	DBLK	;BLT Header into directory
02900		STAX	FBUF
03000		DEX
03100		BPL	HLOOP
03200	
03300		LDAI	1	;First sector.
03400		STAZ	CSEC
03500		JSR	SWDBUF	;Swap disk buffers.
03600	
03700		JSR	WBUFW	;Write dir. header 0.
03800		LDAI	LASTRK	;Last track
03900		STAZ	CTRK
04000		JSR	WBUFW	;Write dir. header 1.
04100	   ;Write last track directory.
04200		LDAZ	SREM	;Get last dir.sec. number.
04300		STAZ	CSEC
04400		JSR	SWDBUF	;Swap buffers.
04500		JSR	WBUFW
04600		BNE	CLZERR
04700	
04800		LDAZ	SVERR	;?
04900		BEQ	CLOZD
05000	   ;Close error.
05100	CLZERR:	JMP	DIRERR	;?
05200	CLOZD:	STAZ	WFOPEN	;Reset write file open flag.
05300		JMP	ACK
     

00100	PSF:	JSR	GEOT
00200		JSR	PACK	;<Ack>
00300		JSR	GCHR	;Wait for SOH.
00400		CMPI	1	;SOH
00500		BNE	PSFERR
00600		JSR	GCHR	;Wait for special function cmd.
00700		CMPI	"Q"	;Compress holes.
00800		BNE	CKF
00900		JSR	GEOT	;Wait for EOT.
01000		JMP	CMPRES
01100	
01200	CKF:	CMPI	"F"	;Format disk.
01300		BNE	CKI
01400		JMP	FORM
01500	CKI:	CMPI	"I"	;Initialize directory.
01600		BEQ	IDIR
01700	PSFERR:	JMP	ILLCMD	;Command error.
01800	;Initialize directory.
01900	IDIR:	JSR	GEOT	;Wait for EOT.
02000		JSR	MOTON	;Turn on motor.
02100		LDXI	10
02200		LDAI	0
02300	ZE:	STAX	FBUF	;Zero directory
02400		INX
02500		BNE	ZE
02600		LDXI	7
02700	DIIL:	LDAX	DIT	;Init dir.
02800		STAX	FBUF
02900		DEX
03000		BPL	DIIL
03100	
03200		LDXI	4
03300	SETC:	LDAX	ID0	;Setup CBLK.
03400		STAZX	CBLK
03500		DEX
03600		BPL	SETC
03700	
03800		JSR	SETDPO
03900		JSR	WBUFW	;Write first header and dir.
04000		LDAI	LASTRK	;Last track.
04100		STAZ	CTRK
04200		JSR	WBUFW	;Init last directory.
04300	
04400		BEQ	OK	;Check for errors.
04500		LDAZ	SVERR
04600		BNE	IDERR
04700	OK:	JMP	ACK
04800	IDERR:	LDXI	7	;Init dir. error.
04900		JMP	OCLR	;Reset flags.
05000	
05100	DIT:	DMARK
05200		2	;# of sectors
05300		0	;FFDB
05400		1	;FFT
05500		1	;FFS
05600		=264∧377	;FBL?
05700		1	;FBH
05800		0
     

00100	;Delete file.
00200	KIL:	JSR	LOKUP
00300		BEQ	KILIT
00400	FNF:	LDXI	3	;File not found.
00500		JMP	OCLR
00600	KILIT:	LDAI	HMARK
00700		STAY	760	;FBUF - 20
00800		JSR	WBUFW	;Write and wait.
00900		BNE	JDER
01000		LDAI	LASTRK
01100		STAZ	CTRK
01200		JSR	WBUFW	;Write last dir. track.
01300		BEQ	JACK	;No errors.
01400	JDER:	JMP	DIRERR	;Error.
01500	
01600	DIR:	JSR	GEOT	;Wait for EOT.
01700		JSR	RHDR	;Read header.
01800		BNE	JDER
01900		LDAI	0	;Point to start
02000		STAZ	DIRCNT
02100	JACK:	JMP	ACK
02200	
02300	NXTDIR:	JSR	GEOT	;Wait for EOT.
02400		LDXZ	DIRCNT	;Check if at end.
02500		CPXZ	DSEC	;Check if done.
02600		BCC	NXD
02700		JMP	EOF
02800	
02900	NXD:	INX
03000		INX
03100		STXZ	DIRCNT	;Update directory count.
03200		INX	;Bump past dir. header.
03300		STXZ	CSEC
03400		JSR	PACK	;Output <ACK>.
03500	
03600		JSR	RSEC	;Read next directory sector.
03700		BNE	JDER
03800	
03900		JSR	PSTX	;Output <STX>.
04000		LDYI	0
04100	DOL:	LDAY	FBUF	;Find file in FBUF.
04200		CMPI	FMARK
04300		BNE	NXBLK
04400	
04500		LDAI	=10	;9 Chr file name + # of secs.
04600		STAZ	HSEC
04700		LDXI	":"
04800	FBOUT:	JSR	OCHR	;Output it.
04900		INY
05000		LDXY	FBUF	;Get FBLK.
05100		DECZ	HSEC
05200		BPL	FBOUT
05300	
05400	NXBLK:	TYA
05500		ORAI	17	;Next file block.
05600		TAY
05700		INY
05800		BNE	DOL
05900	
06000		BEQ	OEOT	;Jump.
     

00100	;Output free blocks.
00200	BLKS:	JSR	GEOT	;Wait for EOT.
00300		JSR	RHDR	;Read directory header.
00400		BNE	DJ	;Directory read error.
00500		JSR	PACK	;<ack>
00600		JSR	PSTX	;Output STX.
00700		LDXZ	FBLKS
00800		JSR	OCHR
00900		LDXZ	FBH
01000		JSR	OCHR
01100	OEOT:	LDXI	4	;<EOT>.
01200		JMP	OCLR	;Clear flags.
01300	;Compress holes.
01400	CMPRES:	JSR	RHDR	;Read directory header.
01500		BNE	DJ
01600	SQEZ:	JSR	RNDS
01700		BNE	DJ
01800		LDYI	0
01900	CKHOL:	LDAY	FBUF
02000		CMPI	FMARK	;Look for a hole.
02100		BNE	HOLE
02200		TYA
02300		CLC
02400		ADCI	20	;Next directory record.
02500		TAY
02600		BNE	CKHOL
02700	
02800		DECZ	SREM	;SREM ← SREM + 2.
02900		DECZ	SREM
03000		BNE	SQEZ
03100	PACKED:	JMP	ACK	;Done.
03200	DJ:	JMP	DIRERR	;Directory read error.
03300	
03400	;Hole found.
03500	HOLE:	LDAY	1013	;FBUF + TRK#
03600		STAZ	HTRK
03700		LDAY	1014	;FBUF + SEC#
03800		STAZ	HSEC
03900		STYZ	SVHY	;Save hole dir. index.
04000		LDAZ	CSEC
04100		STAZ	SVHSEC	;Save hole dir. sector.
04200	
04300	FINDF:	TYA	;Find next file.
04400		CLC
04500		ADCI	20	;Next dir. record.
04600		TAY
04700		BNE	CKFIL
04800		DECZ	SREM	;SREM ← SREM - 2.
04900		DECZ	SREM
05000		BEQ	PACKED	;Done.
05100		JSR	RNDS	;Read next directory sector.
05200		BNE	DJ	;Error.
05300		TAY	;Y ← 0.
05400	CKFIL:	LDAY	FBUF
05500		CMPI	FMARK
05600		BNE	FINDF
05700	   ;File found. Save file address.
05800		JSR	FMOV	;Save FBLK.
     

00100	;Fill hole.
00200	FILLIT:	LDAZ	FTRK	;Point to file.
00300		STAZ	CTRK
00400		LDAZ	FSEC
00500		STAZ	CSEC
00600		LDAI	123	;Read two sectors command.
00700		STAZ	CBLK
00800		JSR	RCMDW	;Read it.
00900		BNE	DJ
01000	
01100		LDAZ	HTRK	;Point to hole.
01200		STAZ	CTRK
01300		LDAZ	HSEC
01400		STAZ	CSEC
01500		CLC
01600		ADCI	2	;Next hole sectors.
01700		CMPI	=17
01800		BCC	WRIT
01900		INCZ	HTRK	;Next track.
02000		LDAI	1	;First sector.
02100	WRIT:	STAZ	HSEC
02200		JSR	WBUFW	;Fill hole.
02300		BNE	DJ	;?
02400	
02500		DECZ	NSEC	;NSEC ← NSEC - 2.
02600		DECZ	NSEC
02700		BEQ	CUPD	;Check if hole filled.
02800		LDAZ	FSEC
02900		CLC
03000		ADCI	2	;Next file sectors.
03100		CMPI	=17
03200		BCC	UPSEC
03300		INCZ	FTRK	;Next track.
03400		LDAI	1	;First sector.
03500	UPSEC:	STAZ	FSEC
03600		BNE	FILLIT	;Jump.
03700	
03800	CUPD:	LDAZ	SVHSEC	;Update directory.
03900		STAZ	CSEC	;Get hole dir. sector.
04000		LDAI	0	;Track zero.
04100		STAZ	CTRK
04200		JSR	RSEC	;Read hole dir. sector.
04300		BNE	DJ	;?
04400	
04500		LDXI	0
04600		LDYZ	SVHY	;Get hole dir. index.
04700	UPBLK:	LDAZX	FBLK	;FBUF ← FBLK - TRK&SEC
04800		STAY	FBUF
04900		INY
05000		INX
05100		CPXI	13	;FNAME + FMARK & NSEC.
05200		BCC	UPBLK
05300		JSR	WBUFW	;Write new dir.
05400		BNE	DJ	;?
05500	;Find next file.
     

00100	GEOT:	JSR	GCHR	;Wait for EOT.
00200		CMPI	4	;<EOT>
00300		BNE	TERR
00400		LDAZ	CEFLG	;Checkk for comm. error.
00500		BNE	TERR
00600		RTS
00700	TERR:	PLA	;Fix stack?
00800		PLA
00900		JMP	ILLCMD	;?
01000	
01100	FORM:	JSR	GEOT
01200		JSR	MOTON	;Turn on motor.
01300		LDAI	RESTOR
01400		JSR	PCMD	;Seek track zero?
01500	RSTORW:	BITZ	BUSY	;Wait until at track zero.
01600		BMI	RSTORW
01700	
01800		JSR	SETDPO	;Point to FBUF.
01900		LDXI	6
02000	CSLOP:	LDAX	FORMT	;Setup command list.
02100		STAZX	CBLK
02200		DEX
02300		BPL	CSLOP
02400	
02500	TKOOP:	LDXI	1	;First sector.
02600		LDYI	0
02700	SCOOP:	LDAZ	FOTRK	;Get track number.
02800		STAY	FBUF	;And setup I.D.s.
02900		INY
03000		LDAI	0
03100		STAY	FBUF	;Head number.
03200		INY
03300		TXA
03400		STAY	FBUF	;Sector number.
03500		INY
03600		LDAI	0
03700		STAY	FBUF	;Length.
03800		INY
03900		INX	;Next sector.
04000		CPXI	=17	;Sectors per track +1.
04100		BCC	SCOOP
04200	
04300		JSR	WUF	;Write buffer.
04400	FW:	BITZ	BUSY	;Wait until not busy.
04500		BMI	FW
04600	   ;Add verify 16 sectors?
04700		INCZ	FOTRK	;Next track.
04800		LDAZ	FOTRK
04900		CMPI	=35
05000		BCC	TKOOP
05100	
05200		LDAZ	SVERR	;Check for errors.
05300		BNE	FERR
05400		JMP	ACK
05500	FERR:	JMP	DIRERR
     

00100	;Wait for input.
00200	GCHR:	LDA	SIOC	;Read SI/O status.
00300		LSRA	;Get rcvr. full bit.
00400		BCC	GCHR
00500		ANDI	30	;FE, OVR.
00600		BEQ	GOT1
00700		STAZ	CEFLG
00800	GOT1:	LDA	SIOD
00900		RTS
01000	
01100	PACK:	LDXI	6	;Output <ack>.
01200	;Output byte in X.
01300	OCHR:	LDA	SIOC	;Read SI/O status.
01400		ANDI	2	;Transmiter full bit.
01500		BEQ	OCHR
01600		STX	SIOD	;Output it.
01700		RTS
01800	PSTX:	LDXI	2	;Output <stx>.
01900		BNE	OCHR
02000	
02100	MOTOFF:	LDAI	MOFF	;Turn motor off.
02200		JSR	PCMD
02300		LDAI	0
02400		STAZ	MO	;Motor on flag.
02500		RTS
02600	
02700	   ONES ← 6	;6 = .98s, 7 = 1.15s.
02800	MOTON:	BITZ	MO	;Check if already on.
02900		BMI	SPIN
03000		LDAI	377	;Turn on motor.
03100		STAZ	TL	;Setup motor time out.
03200		LDAI	ONES
03300		STAZ	TH
03400		LDAI	MON	;Turn it on.
03500		JSR	PCMD
03600	
03700		LDXI	0	;Wait for motor on delay.
03800	MW:	DEX
03900		BNE	MW
04000		DECZ	TL
04100		BNE	MW
04200		DECZ	TH
04300		BNE	MW
04400	
04500		LDAI	377
04600		STAZ	MO	;Set motor on flag.
04700	SPIN:	LDAI	377	;Setup motor time out.
04800		STAZ	TL
04900		LDAI	TWOS
05000		STAZ	TH
05100		RTS
05200	
05300	;Reset and interrupt vectors.
05400	   LOC ZERO + 177772
05500		NMIV∧377	;NMI Vector.
05600		NMIV⊗-10
05700		RST∧377	;Reset vector.
05800		RST⊗-10
05900		IRQV∧377	;IRQ Vector.
06000		IRQV⊗-10
06100	END